home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 July / Macworld (1999-07).dmg / Shareware World / Info / For Developers / Mops 3.4.sea / Mops source / PPC source / pFiles < prev    next >
Text File  |  1999-02-15  |  16KB  |  692 lines
  1. \ Files  - file object and loader
  2.  
  3. -39        constant    EOF            \ EOF error return
  4. -43        constant    FNF            \ File not found ditto
  5.  
  6. -300     constant    FILE-MARK
  7.  
  8. \ Marks the start of a loaded file - we plant some useful info there.
  9. \ We put the file name in the dic as if it's a definition name, but use
  10. \ file-mark as a "handler code".  Then after that we put the useful info.
  11. \ See extrasMod.
  12.  
  13. false    value    ASYNCH?
  14. false    value    ENDLOAD?
  15. false    value    LOG?
  16.  
  17.     0    value    OPEN_CNT
  18.     0    value    CLOSE_ERR_CNT
  19.  
  20. forward    CREATE_LOG
  21. forward    WRITE_LOG
  22. \ forward OK?
  23.  
  24.     string  $tmp
  25.     string    $marker
  26.  
  27. sysCall  SFGetFile
  28. sysCall  SFPutFile
  29.  
  30. sysCall     PBOpenSync
  31. sysCall  PBCloseSync
  32. sysCall  PBCreateSync
  33. sysCall  PBDeleteSync
  34.  
  35. sysCall  PBReadSync
  36. sysCall  PBWriteSync
  37.  
  38. sysCall  PBSetFPosSync
  39. sysCall  PBSetEOFSync
  40. sysCall  PBGetEOFSync
  41.  
  42. sysCall  PBHGetFInfoSync
  43. sysCall  PBHSetFInfoSync
  44. sysCall  PBRenameSync
  45. sysCall  PBFlushVolSync
  46.  
  47.  
  48. : ?DISABLE_ACTW
  49.             \ deactivates the front window if it's one of ours.  Call before
  50.             \  putting up a dialog, since that doesn't automatically cause a
  51.             \  deactivate event, for some strange reason.
  52.  
  53.     actW IF  disable: [ actW ]  THEN  ;
  54.  
  55. (* ***** don't want asynch stuff at this stage on the PPC, since it would
  56.     involve us in all that nasty UPP stuff...
  57.     
  58. : ASYNCH    true -> asynch?  ;
  59.  
  60. : IOWAIT    BEGIN  busy  0EXIT  pause  AGAIN   ;
  61.  
  62. : (ASY)        \ ( fcb -- )  Sets up for a low-level asynchronous read or write.
  63.     IOwait
  64.     -> busy  setCP  ;
  65. *)
  66.  
  67. : VOLNAME?  { str -- b } 
  68.     reset: [ str ]
  69.     58 str chsearch: [ str ]
  70.     NIF  false  EXIT  THEN
  71.     lim: [ str ]  2 >=  ;
  72.  
  73.  
  74. forward  OPEN_WITH_PATHS
  75.  
  76. false    value    USE_PATHS?
  77.  
  78. true    constant    HFS?            \ always true on PPC
  79.  
  80. variable    MyDocName    28 allotx
  81.  
  82. : MyDoc        \ ( -- addr len )
  83.     MyDocName  count  ;
  84.  
  85.  
  86. \ Standard file package support
  87.  
  88. : SFLOC  {  \ wd ht -- wd:ht }
  89.         \ Computes screen coordinates for top left of
  90.         \ SF dialog box.  Centers the box horizontally, and a bit above
  91.         \ the center vertically.
  92.         \ We return a Point, so we have to do a pack.
  93.     screenbits  -> ht  -> wd  2drop
  94.     ht 3 /  80 -  0 max  -> ht
  95.     wd 2/  170 -  0 max  -> wd
  96.     wd ht  pack  ;
  97.  
  98.  
  99. :class     SFrec    super{ object } 
  100.  
  101. 68k_record
  102. {    byte        Good
  103.     byte        count            \ actually not used
  104.     var            fType
  105.     int            vRefNum
  106.     int            Version
  107.  64    bytes        Filename        \ max size is 64
  108. }
  109. 4    ordered-col    fTypes            \ list of filetypes
  110.  
  111.  
  112. :m GetVRefNum:    get: vRefNum   ;m
  113. :m GetName:        addr: FileName   ;m
  114.  
  115. :m CALL:    \ ( routine# -- bool )  Calls a Standard File Package routine.
  116.     ?disable_actw
  117.     0  ^base  rot  
  118.     get: good  ;m
  119.  
  120. :m STDGET:  ( type0 ...typeN ) { #types -- bool } 
  121.     clear: fTypes  #types  0>
  122.     IF    #types 0  DO  add: fTypes  LOOP  THEN
  123.     SFloc
  124.     0  0  #types  ixAddr: fTypes  0  ^base  SFGetFile
  125.     get: good  ;m
  126.  
  127.  
  128. :m STDPUT:  {  pAddr pLen nAddr nLen -- bool } 
  129.     pAddr pLen pad place
  130.     SFloc
  131.     pad  nAddr nLen  str255
  132.     0  ^base  SFPutFile
  133.     get: good  ;m
  134.  
  135. ;class 
  136.  
  137.  
  138. \ objHandle    SFHDL
  139. \ objPtr    SFOBJ   class_is  SFrec
  140.  
  141. (*    DO_OPEN does the hard work for OPEN: in File.  First, if either the DirID
  142.     or the vol ref# is non-zero, we rashly assume we know which folder we
  143.     want, and just do an open.  We also do that if we're not running under HFS.
  144.     Then, if we get through to here, we need to look at the paths.  But wait!
  145.     First, we check the default folder by just doing a plain open anyway!  If
  146.     this fails with a "file not found", we call ?USE_PATHS which either does
  147.     nothing (if we're not using a path designator file), or calls our PATHSMOD
  148.     module to look at a PD file and try using those paths to find the wanted
  149.     file.
  150. *)
  151.  
  152. : DO_OPEN  { perm -- rc }
  153.     1 ++> open_cnt
  154.     perm  ^base 27 + c!                \ set permission
  155.     ^base 48 + @                    \ DirID
  156.     ^base 22 + w@                    \ vol ref#
  157.     or                                \ Either non-zero?
  158.     use_paths? not  or                \ Or paths disabled?
  159.     IF                                \ Yes: just do a normal open, and get out.
  160.         ^base  PBOpenSync  EXIT
  161.     THEN
  162.                                     \ Maybe use HFS paths:
  163.     ^base PBOpenSync dup  0EXIT        \ Try default folder first
  164.                                     \ -- out if we found it
  165.     dup FNF <>  ?EXIT                \ If err wasn't FNF, get out
  166.     use_paths?  0EXIT                \ If paths disabled, out with FNF
  167.     drop  ^base perm open_with_paths
  168. ;
  169.  
  170.  
  171. SFRec    SFObj
  172.  
  173. :class   FILE    super{ object }        general
  174.  
  175. 136    bytes        FCB            \ max parameter block (108 but for hgetvinfo)
  176.                             \  then 4-byte align for PPC
  177.  
  178. 68k_record    FSSpec
  179. {    int            FSvRefNum
  180.     var            FSDirID
  181. 256    bytes        FileName
  182. }
  183.  
  184. :m CLEAR:        \ Clears the fcb, except for the filename.
  185.     ^base  18 erase  ^base 22 +  112 erase  ;m
  186.  
  187. :m SETNAMEPTR:    \ Sets filename pointer in the FCB.
  188.     ^base 142 +  ^base 18 + !  ;m
  189.  
  190. :m NAME:        \ ( addr len -- )  Assigns file name to fcb.  Rest cleared.
  191.     setNamePtr: self  clear: self
  192.     ^base 142 +  >r                    \ Addr of filename (at end of fcb)
  193.     r@  256 blanks
  194.     ( addr len )  255 min  r>  >str255  drop  ;m
  195.  
  196. :m SETDIRID:    \ ( dirid -- )  Sets the DirID for the fcb
  197.     ^base 48 +  !  ;m
  198.  
  199. :m GETDIRID:    \ ( -- dirid )  Gets the DirID for the fcb
  200.     ^base 48 +  @  ;m
  201.  
  202. :m GETFREF:    \ ( -- fref )  Gets the file ref number.
  203.     ^base 24 +  w@  ;m
  204.  
  205. :m SETFREF:
  206.     ^base 24 +  w!  ;m
  207.  
  208. :m SETVREF:    \ ( vref# -- )  Sets the volRefNum for the fcb
  209.     ^base 22 +  w!  ;m
  210.  
  211. :m GETVREF:    \ ( -- vref# )  Gets the volRefNum for the fcb
  212.     ^base 22 +  w@  ;m
  213.  
  214.  
  215. :m CLOSE:    \ ( -- rc )   Needs to clear the file RefNum field,
  216.             \ as advised in Mac Tech note # 102.  In fact we clear
  217.             \ the whole fcb except the name and Vref, so we can reuse
  218.             \ the fcb for a subsequent operation without the extra info
  219.             \ left by read and write calls being interpreted as HFS info.
  220.             
  221.     ^base  PBCloseSync  getVref: self  clear: self  setVref: self
  222.     dup if  1 ++> close_err_cnt  else  -1 ++> open_cnt  then  ;m
  223.  
  224.  
  225. :m OPEN:    \ ( -- rc )
  226.     0 do_open  ;m
  227.  
  228. :m OPENREADONLY:
  229.     1 do_open  ;m
  230.  
  231.  
  232. :m NEW:    ^base  PBCreateSync  ;m
  233.  
  234. :m DELETE:    ^base  PBDeleteSync  ;m
  235.  
  236. :m MOVETO:    \ ( byteoffset -- rc )  Positions relative to start of file
  237.     ^base  $ 2E +  !
  238.     ^base PBSetFPosSync  ;m
  239.  
  240. :m POS:        \ ( -- byteoffset )
  241.     inline{ ^base $ 2E + @}  ;m
  242.  
  243. :m SETEOF:    \ ( pos -- rc )  Sets end-of-file to absolute byte position
  244.     ^base 28 + !  ^base  PBSetEOFSync  ;m
  245.  
  246. :m CREATE:  { \ volID -- rc } 
  247.             \ Opens and resets file or creates new if not present.
  248.     1 ++> open_cnt
  249.     ^base  PBOpenSync            \ Attempt to open - don't use paths
  250.     ?dup
  251.     IF    dup FNF =
  252.         IF    drop
  253.             new: self  ?dup NIF  ^base  PBOpenSync  THEN
  254.         THEN
  255.     ELSE
  256.         0 setEOF: self
  257.     THEN  ;m
  258.  
  259. :m CREATENEW:    \ ( -- rc )  Like create:, but if file exists it's deleted
  260.                 \  and created totally new.
  261.     delete: self  drop
  262.     create: self  ;m
  263.  
  264. :m LAST:        \ Positions to end of file.
  265.     big# moveto: self  drop  ;m
  266.  
  267. :m SIZE:        \ ( -- #bytes )  Returns logical eof for file currently open
  268.     ^base  PBGetEOFSync  drop ^base 28 + @  ;m
  269.  
  270. :m BYTESREAD:    \ ( -- n )  Returns actual bytes read.
  271.     ^base 40 + @  ;m
  272.  
  273. :m FCB:  ( -- fcb )     ^base  ;m
  274.  
  275. :m RESULT:    \ ( -- rc )  Returns the last I/O result code.
  276.     ^base 16 + w@  ;m
  277.  
  278. :m MODE:        \ ( posMode -- )  Sets position mode
  279.     inline{ ^base 44 + w!}  ;m
  280.  
  281.  
  282. :m WAIT:    \ ( -- rc )  Waits for asynch I/O on this file to finish.
  283.     BEGIN    ^base busy =
  284.         NIF   ^base 16 + w@x  EXIT  THEN
  285.         pause
  286.     AGAIN  ;m
  287.  
  288. :m ?WAIT:    \ ( rc1 -- rc2 )
  289.     asynch?
  290.     NIF        drop  wait: self
  291.     ELSE    false -> asynch?
  292.     THEN   ;m
  293.  
  294.  
  295. :m READ:  { addr len -- rc }
  296.     0 mode: self
  297.     addr  ^base $ 20 + !
  298.     len      ^base $ 24 + !
  299.     ^base  PBReadSync  ;m
  300.  
  301. :m READLINE:  { addr maxLen -- rc }        \ Reads terminating with CR
  302.     $ 0D80 mode: self
  303.     addr      ^base $ 20 + !
  304.     maxLen    ^base $ 24 + !
  305.     ^base  PBReadSync  ;m
  306.  
  307. :m WRITE:  { addr len -- rc }
  308.     0 mode: self
  309.     addr  ^base $ 20 + !
  310.     len      ^base $ 24 + !
  311.     ^base  PBWriteSync  ;m
  312.  
  313. :m SETNAME:        \ Gets name from input stream, and assigns to fcb.
  314.                 \  The name can have embedded blanks and be delimited
  315.                 \  by " ... ", or just terminate at the end of line.
  316.  
  317.     bl skip-src+  & "  parse-word  name: self  ;m
  318.  
  319. :m GETNAME:        \ ( -- addr len )  Returns filename
  320.     addr: fileName  count  ;m
  321.  
  322. :m PRINT:        \ Prints the filename.
  323.     getName: self  type  ;m
  324.  
  325. :m GETFILEINFO:        \ ( -- rc )  Fills the parameter block with file info
  326.     ^base  PBHGetFInfoSync  ;m
  327.  
  328. :m SETFILEINFO:        \ ( -- rc )
  329.     ^base  PBHSetFInfoSync  ;m
  330.  
  331. :m SET:  { ftyp sig -- }            \ Sets file type, signature.
  332.     getDirID: self                    \ Save DirID
  333.     0 setDirID: self                \ and clear it (otherwise we'll get
  334.     getFileInfo: self  drop            \  "file not found")
  335.     sig  ^base  $ 24 +  !            \ Set signature
  336.     ftyp ^base  $ 20 +  !            \ Set type
  337.     0 setDirID: self
  338.     setFileInfo: self  drop
  339.     setDirID: self  ;m                \ Restore DirID
  340.  
  341.  
  342. \ :m DRIVE:    \ ( drive# -- )  set default drive to drive#
  343. \    clear: self  setVRef: self  ^base  PBSetVolSync
  344. \    IF 165 die  THEN  ;m
  345.  
  346. :m ACCEPT:  { addr len \ #chrs eof? -- #chrs eof? }     \ ACCEPTs from disk.
  347.     echo? IF  addr len erase  THEN            \ So the typed line is OK
  348.     addr len  readLine: self  -> eof?
  349.     bytesRead: self  eof? NIF  1-  THEN  -> #chrs
  350.     #chrs 0=  eof? and  IF  0  true  EXIT  THEN
  351.     addr #chrs +  c@  13 <>
  352.     IF                                \ Overlength line. Probably a comment.
  353.         BEGIN                        \ Gobble to CR or EOF
  354.             pad 100  readLine: self  -> eof?
  355.             eof?
  356.             IF        true
  357.             ELSE    pad  bytesRead: self  1-  +  c@ 13 =
  358.             THEN
  359.         UNTIL
  360.     THEN
  361.     #chrs -> len
  362.     echo?
  363.     IF    addr len type  cr  THEN
  364.     BEGIN                            \ Loop to convert tabs to blanks
  365.         addr len  9 scan  -> len  -> addr
  366.         len
  367.     WHILE
  368.         bl addr c!
  369.     REPEAT
  370.     #chrs  false   ;m
  371.  
  372.  
  373. :m RENAME: { taddr tlen -- rc } 
  374.     taddr tlen str255
  375.     ^base 28 + !  ^base  PBRenameSync  ;m
  376.  
  377.  
  378. :m GETTYPE:        \ ( -- type )
  379.     ^base 32 + @  ;m
  380.  
  381. :m FLUSHVOL:
  382.     ^base  PBFlushVolSync  drop  ;m
  383.  
  384.  
  385. :m CLASSINIT:
  386.     clear: self  setNamePtr: self  ;m
  387.  
  388.  
  389. \ Standard file package calls.  If the value SFDlgHook is non-zero, we take it as the
  390. \ address of a dialog hook routine.
  391.  
  392. private
  393.  
  394. :m SFPCALL:        \ ( various get? -- b )  Calls a Standard File Package routine
  395.     classinit: self                        \ Make sure name pointer is right
  396.     IF    stdGet: SFobj  ELSE  stdPut: SFobj  THEN
  397.     IF    getVRefNum: SFobj  clear: self  setVref: self
  398.         getName: SFobj  count  addr: fileName  place
  399.         true
  400.     ELSE
  401.         false
  402.     THEN
  403. ;m
  404.  
  405. public
  406.  
  407. :m STDGET:    \ ( type0 ...typeN #types -- bool )
  408.     true sfpCall: self  ;m
  409.  
  410. :m STDPUT:    \ ( pAddr pLen nAddr nLen -- bool )
  411.     false sfpCall: self  ;m
  412.  
  413. ;class 
  414.  
  415.  
  416. file FFCB
  417.  
  418. (*
  419. $ BC1F  ' ffcb 2-  w!
  420. ' file  ' ffcb 4+  reloc!x        \ Make fFcb a FILE objPtr
  421.  
  422. ' file    ffcb 8 -  reloc!x
  423. -4    fFcb 4 -    w!
  424. 2    ffcb 2 -    w!
  425. *)
  426.  
  427. \ GetDirID returns the dirID of the last directory opened by a
  428. \ standard file call.
  429.  
  430. syscall LMGetCurDirStore
  431.  
  432. : GETDIRID    LMGetCurDirStore  ;
  433.  
  434.  
  435. \ FileList keeps a stack of open load files for nested loads.
  436.  
  437. objPtr    TOPFILE  class_is  file
  438.  
  439.  
  440. \ :class     FILELIST  super{ handleArray } 
  441. :class  FILELIST  super{ handleList }
  442.  
  443. :m DROP:
  444.     top: super                        \ Give error if empty
  445.     close: topFile  drop
  446.     drop: super
  447.     size: super  NIF  nilP  ELSE  obj: self  THEN
  448.     -> topFile
  449.     false -> endload?   ;m
  450.  
  451. :m PUSHNEW:        \ Adds a new file to the stack
  452.     ['] file  pushNewObj: self
  453.     false -> endload?
  454.     obj: self  -> topFile            \ Note this locks the file object
  455.                                     \ -- this is what we want.
  456.     0 setVref: topFile   ;m
  457.  
  458. :m CLEAR:    \ Removes all currently open files
  459.     false -> endload?
  460.     size: super  0EXIT
  461.     ." File stack: "  cr  top: self
  462.     size: super
  463.     FOR        print: topFile  cr  drop: self
  464.     NEXT  ;m
  465.  
  466. ;class 
  467.  
  468.  
  469. \ 10    fileList    LOADFILE
  470.     fileList    LOADFILE
  471.  
  472. 0    value        FILESTART_DP
  473. 0    value        CNT
  474. 0    value        SvLATEST
  475.  
  476. (*
  477. : LOGIT
  478.     state  0EXIT                    \ Out if we're not compiling
  479.     here filestart_DP -  pad w!
  480.     pos: topFile  src-len -
  481.     pad 2+  !
  482.     pad 6  add: $lg1  ;
  483.  
  484.  
  485. 0    value    LASTPOS
  486.  
  487. : LOGCR
  488.     state  0EXIT
  489.     here lastPos <=  ?EXIT
  490.     here -> lastPos
  491.     pad 14 erase
  492.     here filestart_DP -  pad w!
  493.     latest svLatest <> IF  true pad 4+ c!  latest -> svLatest  THEN
  494.     pad 14  add: $lg2  ;
  495. *)
  496.  
  497.  
  498. :f FREFILL        \ ( -- flag )  Does a refill from a file.
  499.     echo?
  500.     IF        ?pause
  501.     ELSE    cnt NIF  ?pause  20 -> cnt  else  1 --> cnt  THEN
  502.     THEN
  503. \    log? IF  logCR  THEN
  504.     tib tibLen  accept: topfile  ( #chrs eof? ) -> endload?  #tib !
  505.     set_source  endload? 0=
  506. ;f
  507.  
  508. : (fRefill)  fRefill  ;            \ for backwards compatibility
  509.  
  510.  
  511. : (LD)
  512.     BEGIN
  513.         endload? IF  false -> endload?  EXIT  THEN
  514.         topfile -> source-ID  Frefill  IF  interpret  THEN
  515.         state not  echo? and  fWind? and  IF  ." >"  THEN
  516.     AGAIN  ;
  517.  
  518.  
  519. false    value    DO_CR?
  520. false    value    marker_there?
  521.  
  522. : ?file_open_error  { OSErr -- }
  523.     OSErr  0EXIT                        \ out if no error
  524.     getName: topfile  type
  525.     OSErr FNF = IF  132 die  THEN        \ file not found
  526.     OSErr cr .  155 die                    \ other error opening file
  527. ;
  528.  
  529.  
  530. : BL>01        \ ( addr len -- )  Replaces blanks with 01's in the string.
  531.     bounds
  532.     ?DO        i c@  bl = IF  $ 01  i c!  THEN
  533.     LOOP
  534. ;
  535.  
  536. : 01>BL        \ ( addr len -- )  Replaces 01's with blanks in the string.
  537.     bounds
  538.     ?DO        i c@  $ 01 = IF  bl  i c!  THEN
  539.     LOOP
  540. ;
  541.  
  542.  
  543. : FNAME>MNAME    \ ( addr len -- )    Takes the passed-in filename, and converts it to
  544.                 \  the corresponding file marker name in $marker.
  545.  
  546.     new: $marker  put: $marker
  547.     & :  <chsearch: $marker  negate skip: $marker
  548.     <step: $marker  delete: $marker
  549.     all: $marker bl>01            \ replace any blanks
  550.     begin: $marker  " m__" insert: $marker        \ prepend "m__"
  551.     reset: $marker
  552. ;
  553.  
  554. : MNAME>FNAME    \ ( addr len -- )    Takes the passed-in marker name, and
  555.                 \  converts it to  the corresponding filename in  $marker.
  556.     3 /string                                \ skip the "m__"
  557.     new: $marker  put: $marker  all: $marker 01>bl    \ and recover any blanks
  558.     reset: $marker
  559. ;
  560.  
  561. 0    value    mk_cfa
  562.  
  563. : mark_file  ( addr len -- )
  564.     " marker" sFind nip NIF 2drop EXIT THEN        \ out if MARKER not defined yet
  565.     fname>mname
  566.     begin: $marker  " marker " insert: $marker
  567.     lock: $marker  all: $marker  evaluate
  568.     release: $marker
  569.     true -> marker_there?
  570.     CDP 10 -  -> mk_cfa        \ markers have 2 spare bytes at the cfa,
  571.     1 mk_cfa w!                \  so we store 1 there to show this is a file
  572.                             \  mark
  573. ;
  574.  
  575.     
  576. : LOADTOP  {  \ svCurs svDP svCDP svDepth len rc -- } 
  577.                             \ Interprets the file as a Mops source file.
  578.     openReadOnly: topfile  ?file_open_error
  579.  
  580.     marker_there?  false -> marker_there?
  581.     IF
  582.         getFileInfo: topfile -> rc
  583.         topFile 48 + @  code,            \ put source dirID after marker info
  584.                                         \  at offs 10 from cfa
  585.         topFile 76 + @  code,            \ then the mod date at offs 14
  586.         getName: topfile                \ this will be the full pathname
  587.         dup -> len
  588.         CDP place  len 1+ ++> CDP        \ store it after the mod date,
  589.                                         \  at offs 18
  590.         code_align
  591.  
  592.     \ now for some mysterious reason, if we've just saved the file
  593.     \  in Quick Edit and we get the file info, we get EOF the first time
  594.     \  we try to read from it.  So we'll do a dummy read, then close
  595.     \  and re-open it.
  596.     
  597.         pad 1  read: topfile  drop  close: topfile  drop
  598.         openReadOnly: topfile  ?file_open_error
  599.     THEN
  600.     
  601.     curs? -> svCurs  -curs
  602.     cr
  603.     size: loadFile 2*  spaces  ." Loading: " 
  604.     getName: topfile  type
  605.  
  606.     DP -> svDP  CDP -> svCDP  depth -> svDepth
  607.     false -> endload?  false -> do_cr?
  608.     (ld)
  609.     close: topfile  drop
  610.     do_cr?
  611.     IF  cr  size: loadFile 2*  ELSE  2  THEN  spaces  true -> do_cr?
  612.     ." Code: "
  613.     CDP 
  614.     svCDP IF  svCDP  ELSE  code_start  THEN  -  .
  615.     DP  svDP  -  ."   data: "  .
  616.     size: loadFile 1 <= IF  cr  THEN
  617.     depth svDepth <> IF  cr ." Warning - stack depth changed" cr  THEN
  618.     svCurs -> curs?
  619. ;
  620.  
  621.  
  622. : ENDLOAD        true -> endload?  0 -> src-len  ;    ppc_only
  623.  
  624.  
  625. \ Nesting loader.  Usage: // filename
  626.  
  627.  
  628. : (load)
  629.     room2            \ ( -- code-room data-room )
  630.     512  < IF  204 die  THEN        \ bail out on insufficient free space
  631.     1024 < IF  203 die  THEN
  632.     getName: topfile  mark_file
  633.     loadTop
  634.     drop: loadFile
  635. ;
  636.  
  637. : //
  638.     pushNew: loadFile  setName: topFile
  639.     (load)
  640. ;            ppc_only
  641.  
  642.  
  643. : INCLUDED  { addr len -- }        \ loads the named file, if not loaded already
  644.     addr len  fname>mname
  645.     all: $marker  sfind  nip
  646.     IF  release: $marker  EXIT  THEN        \ Found - nothing else to do
  647.     pushNew: loadFile
  648.     addr len  name: topFile
  649.     (load)
  650. ;
  651.  
  652.  
  653. : NEED  ( --<filename> )
  654.     word"  count                \ Get name from input
  655.     included  ;
  656.  
  657.     
  658.  
  659. \ CL2 is the next cleanup word - it cleans up all file stuff on abort,
  660. \ as well as whatever we were doing before (see CL1 in file Class).
  661.  
  662. : NOMOD
  663.     -1 -> modcode  -1 -> moddata
  664. \    -1 -> modcode_start  -1 -> modcode_limit
  665. \    -1 -> moddata_start  -1 -> moddata_limit
  666.     -1 -> modcode_comp_start
  667.     -1 -> moddata_comp_start
  668.     0 -> compmod  0 -> comp_seg#
  669. ;
  670.  
  671. : clFiles
  672.     clear: loadfile  close: ffcb drop
  673.     nilP -> topfile
  674.     nomod
  675. \    release: $lg1  release: $lg2
  676. \    ['] null  -> logvec
  677.     false -> endload?
  678.     false -> savingDic?
  679. ;
  680.  
  681.  
  682. : filinit
  683. \    fFcb 18 + @                \ Name pointer - doc name may not be in fFcb
  684. \    count  32 min  myDocName place
  685.     classinit: loadfile  nilP -> topfile
  686.     false -> MRopen?
  687. ;
  688.  
  689.  
  690. \ ' filinit    -> objinit        - filinit now called from init1 in cg7
  691. \ ' clFiles    -> abortvec
  692.